MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 12 - 1996/12.05 May 96/Memory Madness/MemoryMadness.p

Text File | 1996-02-15 | 4.9 KB | 195 lines | [TEXT/CWIE]

program MemoryMadness;

    uses
        Memory, Resources, Files,
        MemoryMadnessC;

    procedure DemonstratePointer;
        var
            data: Ptr;
    begin
        data := NewPtr( 1024 ); { allocate 1024 bytes }
        if data <> nil then begin
            writeln( 'NewPtr allocated 1024 bytes' );
            { You now have 1024 bytes pointed to by data }
            BlockMove( data, data, 1024 ); { do whatever }
            DisposePtr( data ); { release the memory }
            data := nil; { a good habit }
        end else begin
            writeln( 'NewPtr failed with error ', MemError );
        end;
    end;

    procedure DemonstrateHandle;
        var
            data: Handle;
    begin
        data := NewHandle( 1024 ); { allocate 1024 bytes }
        if data <> nil then begin
            writeln( 'NewHandle allocated 1024 bytes' );
            { You now have 1024 bytes pointed to by data^ }
            BlockMove( data^, data^, 1024 ); { do whatever }
            DisposeHandle( data ); { release the memory }
            data := nil; { a good habit }
        end else begin
            writeln( 'NewHandle failed with error ', MemError );
        end;
    end;

    procedure DontDemonstrateFakeHandle; { DO NOT DO THIS! }
        var
            data: Ptr;
            fake: Handle;
    begin
        data := NewPtr( 1024 );
        fake := @data; { fake is now a "fake handle" }
        { under no circumstances should you pass this to a routine expecting a handle }
        SetHandleSize( fake, 100 ); { THIS IS WRONG! }
        DisposeHandle( fake ); { THIS IS WRONG! }
    end;

    procedure DontDemonstrateWritingToMasterPointer; { DO NOT DO THIS! }
        var
            data: Ptr;
            bad: Handle;
    begin
        data := NewPtr( 1024 );
        if data <> nil then begin
            bad := NewHandle( 2048 );
            if bad <> nil then begin
                { ok so far, but not this }
                SetPtrSize( bad^, 200 ); { THIS IS WRONG! }
                bad^ := data; { THIS IS WRONG! }
                bad^ := Ptr(longint(bad^) + 10); { THIS IS WRONG! }
                DisposeHandle( bad ); { too late, it’s toast already }
                bad := nil; { too little to late }
            end else begin
                writeln( 'DontDemonstrateWritingToMasterPointer failed with error ', MemError );
            end;
            DisposePtr( data );
        end else begin
            writeln( 'DontDemonstrateWritingToMasterPointer failed with error ', MemError );
        end;
    end;

    procedure DemonstrateMovingHandle;
        var
            master: Ptr;
            data, other: Handle;
    begin
        data := NewHandle( 1024 );
        if data <> nil then begin
            other := NewHandle( 1024 );
            if other <> nil then begin
                master := data^; { Danger!  If the memory manager is called, }
                    { or indeed almost anything is called, master will be out of date }
                BlockMove(master, master, 1024 ); { safe, since BlockMove is known not to move memory }
                SetHandleSize( other, 512 ); { master is now out of date! }
                master := nil; { a good habit }
                HLock( data ); { dont let data move around in memory }
                master := data^;
                SetHandleSize( other, 256 ); { master is still guarenteed to be correct }
                BlockMove(master, master, 1024 ); { safe since master is still correct }
                DisposeHandle( other ); { release the memory }
                other := nil; { a good habit }
            end;
            DisposeHandle( data ); { release the memory }
            data := nil; { a good habit }
            master := nil; { master is no longer valid! }
        end else begin
            writeln( 'DemonstrateMovingHandle failed with error ', MemError );
        end;
    end;

    procedure DontDemonstrateFakePointerorHandle;
    { Memory Madness point 2 }

    var
        h:handle;

    begin
        h := NewHandle( 10 );
        SetPtrSize( h^, 20 );
    end;

    procedure DoStuff(aPtr:Ptr;hsize:Size);

    begin
        { A do nothing procedure }
        aPtr:=aPtr;  {UNUSED}
        hsize:=hsize;  {UNUSED}
    end;

    procedure DontDemonstrateSetupData( data: Handle );
    { Memory Madness point 6 }

    begin
        HLock( data );
        DoStuff( data^, GetHandleSize( data ) );
        HUnlock( data );
    end;

    procedure DemonstrateInitializeData( data: Handle );
    { Memory Madness point 6 }

    var
        state: SignedByte;
    begin
        state := HGetState( data );
        HLock( data );
        DoStuff( data^, GetHandleSize( data ) );
        HSetState( data, state );
    end;

    procedure DisposeAnything( var h: Handle );
    begin
        if h <> nil then begin
            if HomeResFile( h ) <> -1 then begin
                ReleaseResource( h );
            end else begin
                DisposeHandle( h );
            end;
            h := nil;
        end;
    end;

    procedure DemonstrateCloseResFile;

    var
        str1, str2,result:StringHandle;
        resfile:integer;
        spec:FSSpec;
        oe:OSErr;

    begin
        oe:=FSMakeFSSpec(0,0,'MemoryMadnessData.rsrc',spec);
        if oe=noErr then begin
            result := nil;
            resfile := FSpOpenResFile( spec, fsRdPerm );
            if resfile <> -1 then begin
                str1 := StringHandle(GetResource( 'STR ', 128 ));
                str2 := StringHandle(GetResource( 'STR ', 129 ));
                if (str1 <> nil) & (str2 <> nil) then begin
                    if length(str1^^) > length(str2^^) then begin
                        result := str1;
                    end else begin
                        result := str2;
                    end;
                    DetachResource( Handle(result));
                end;
                CloseResFile( resfile );
            end;

            writeln(result^^);
            DisposeHandle(Handle(result));
        end;
    end;

begin
    writeln( 'Starting' );
    DemonstratePointer;
    DemonstrateHandle;
    DemonstrateMovingHandle;
    DemonstrateCloseResFile;
    DoCStuff;
end.